home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
KMAGV3.ZIP
/
KMAGUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-01-11
|
11KB
|
386 lines
{THE KING MAGAZINE UNIT FOR PASCAL }
{WRITING BY THE KING IN 01/02/96 }
Unit KMagUnit;
Interface
Uses Dos;
Type
{A Picture Type}
PicType = Array[0..64000] Of Byte; {Pointer To The Pictures}
PicTypeP = ^PicType;
{Red , Green , Blue Type}
RGB = Record {A Record Of Red,Green,Blue}
R,G,B:Byte;
End;
{Palette Type}
PalType = Array[0..255] Of RGB; {256 Color Of Red Green Blue}
{Mouse Button Types}
ButtonType = (None,Left,Right,LeftRight);
{Mouse Type}
MouseType = Record
X,Y:Word;
Buttons : ButtonType;
End;
{Cel Format Header}
CelHeader=Record {A Cel File Header}
Sign:Word;
W,H:Word;
X,Y:Word;
Depth:Byte;
Compress:Byte;
Data:LongInt;
Filler:Array[1..16] OF Byte;
Pal:PalType;
End;
Var
Keys : Array[1..128] Of Boolean; {The Keys status}
Mouse:MouseType;
{-------------------Set Modes Routines-----------------}
Procedure SetMode;
Procedure SetTextMode;
{-------------------Graphics Routines------------------}
Procedure PutPixel(X,Y:Integer;Col:Byte);
Procedure ShowPic(Pic:PicTypeP);
{--------------------Palette Routines-------------------}
Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Procedure SetColor(Col:Byte;R,G,B:Byte);
Procedure ShowPal(Var Pal:PalType);
Procedure GetPal(Var Pal:PalType);
Procedure FadeTo(Pal,ToPal:PalType);
{----------------------File Formats---------------------}
Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;
{------------------------Effects------------------------}
Procedure MakeCrossFade(Pic1,Pic2:PicTypeP;Var Pic3:PicTypeP;
Var PalP1,PalP2,PalCp1,PalCp2:PalType);
{-------------------KeyBoard Routines-------------------}
Procedure InitKeyBoard;
Procedure RestoreKeyBoard;
{------------------------------Mouse Routines------------------------------}
Function ResetMouse:Boolean;
Procedure GetMouse(Var Mouse:MouseType);
Procedure ShowMouse;
Procedure HideMouse;
Implementation
Var
OldInt9 : Procedure;
{-----------------------------Set Modes Routines---------------------------}
{------------------------------------------------}
{Set Mode To Mode 13H , 320x200x256 Colors.. }
{------------------------------------------------}
Procedure SetMode;Assembler;
Asm
Mov Ah,00h {Function 00,13 Interrupt 10h / SET MODE}
Mov Al,13h
Int 10h {SETING TO MODE 13H}
End;
{------------------------------------------------}
{Set Mode To Mode 3H , 80x25x16 Colors.. }
{------------------------------------------------}
Procedure SetTextMode;Assembler;
Asm
Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
Mov Al,3h
Int 10h {SET MODE TO MODE 3 / TEXT MODE}
End;
{----------------------------Graphics Routines-----------------------------}
{------------------------------------------------}
{Plot a single pixel on the screen . }
{------------------------------------------------}
Procedure PutPixel(X,Y:Integer;Col:Byte);Assembler;
Asm
Mov Ax,0a000h {Ax = SEGMENT OF THE SCREEN}
Mov Es,Ax {Es = SEGMENT OF THE SCREEN}
Mov Ax,320 {Ax = MAX VERTICAL LINE}
Mul Y {Ax = AX * Y = HORIZONTAL LINE}
Add Ax,X {Ax = VERTICAL LINE + HORIZONTAL LINE = OFFSET}
Mov Di,Ax {DI = OFFSET}
Mov Al,Col {AL = COLOR}
StoSb {[0A000h:OFFSET] = COLOR}
End;
{-----------------------------------------}
{ Show Picture On Screen . }
{-----------------------------------------}
Procedure ShowPic(Pic:PicTypeP);Assembler;
Asm
Push Ds
Mov Ax,Word(Pic+2) {Take The Segment Of Pic}
Mov Ds,Ax
Xor Si,Si {Si = 0}
Mov Ax,0a000h
Mov Es,Ax
Xor Di,Di {Di = 0}
Mov Cx,32000 {32000*2 = 64000}
Rep MovSw {Move 32000*2 Bytes}
Pop Ds
End;
{------------------------------Palette Routines----------------------------}
{-------------------------------------------------------}
{Get Red Green And Blue From a Color }
{-------------------------------------------------------}
Procedure GetColor(Col:Byte;Var R,G,B:Byte);Assembler;
ASM
Mov Dx,3c7H {Set To GET COLOR}
Mov Al,Col
Out Dx,Al
Inc Dx {Dx = 3c8H}
Inc Dx {Dx = 3c9H}
Les Di,R {Es:Di = R}
In Al,Dx {Get Red Value}
Mov [Es:Di],Al {R = Red Value}
In Al,Dx {Get Green Value}
Les Di,G {Es:Di = G}
Mov [Es:Di],Al {G = Green Value}
In Al,Dx {Get Blue Value}
Les Di,B {Es:Di = B}
Mov [Es:Di],Al {B = Blue Value}
END;
{-------------------------------------------------------}
{Set Red Green And Blue To a Color }
{-------------------------------------------------------}
Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
Asm
Mov Dx,3c8h {SET TO SET COLOR}
Mov Al,Col
Out Dx,Al
Inc Dx {DX = 3c9h}
Mov Al,R {Senting Red Value}
Out Dx,Al
Mov Al,G {Senting Green Value}
Out Dx,Al
Mov Al,B {Senting Blue Value}
Out Dx,Al
End;
{---------------------------------------------------}
{ Show The Palette }
{---------------------------------------------------}
Procedure ShowPal(Var Pal:PalType);
Var T:Byte;
Begin
For T:=0 To 255 Do
SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Get The Use Palette From The Screen }
{---------------------------------------------------}
Procedure GetPal(Var Pal:PalType);
Var T:Byte;
Begin
For T:=0 To 255 Do
GetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Fade To The Screen From Palette To Palette. }
{---------------------------------------------------}
Procedure FadeTo(Pal,ToPal:PalType);
Var
T,T1:Byte;
Begin
For T1:=1 To 63 Do
Begin
For T:=1 To 255 Do
Begin
If Pal[T].R > ToPal[T].R Then
Dec(Pal[T].R);
If Pal[T].R < ToPal[T].R Then
Inc(Pal[T].R);
If Pal[T].G > ToPal[T].G Then
Dec(Pal[T].G);
If Pal[T].G < ToPal[T].G Then
Inc(Pal[T].G);
If Pal[T].B > ToPal[T].B Then
Dec(Pal[T].B);
If Pal[T].B < ToPal[T].B Then
Inc(Pal[T].B);
End;
ShowPal(Pal);
End;
End;
{-------------------------------File Formats-------------------------------}
Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;
Var F:File;
Cel:CelHeader;
Begin
{$I-}
Assign(F,Name);
Reset(F,1);
{$I+}
If IoResult=0 Then
Begin
LoadCel:=True;
BlockRead(F,Cel,SizeOf(Cel));
BlockRead(F,Where,FileSize(F)-SizeOf(Cel));
Pal:=Cel.Pal;
Close(F);
End
Else
Begin
LoadCel:=False;
End;
End;
{---------------------------------Effects----------------------------------}
{---------------------------------------------}
{Build The Picture Of The Cross Fade }
{---------------------------------------------}
Procedure MakeCrossFade(Pic1,Pic2:PicTypeP;Var Pic3:PicTypeP;
Var PalP1,PalP2,PalCp1,PalCp2:PalType);
Var
Colors : Array[0..255] Of Record
Pix1,Pix2:Byte;
End;
T:Word;
T1:Word;
Num:Word;
Pix1,Pix2:Byte;
Begin
T:=0;
Num := 1;
Repeat
Pix1 := PIC1^[T];
Pix2 := PIC2^[T];
For T1 := 0 To Num - 1 Do
Begin
If (Num <> 1) And (Pix1=Colors[T1].Pix1) And (Pix2=Colors[T1].Pix2) Then
Begin
PIC1^[T] := T1;
T1:=256;
Break;
End
End;
If T1 <> 256 Then
Begin
PIC1^[T] := Num;
PalCP1[Num] := PalP1[Pix1];
PalCP2[Num] := PalP2[Pix2];
Colors[Num].Pix1 := Pix1;
Colors[Num].Pix2 := Pix2;
Num := Num + 1;
End;
Inc(T);
If Num > 255 Then
Begin
Writeln('More Then 256 Colors . ');
Halt;
End;
Until(T=64000);
End;
{-----------------------------Keyboard Routines------------------------------}
{--------------------------------------------}
{New Interrupt 9 for handle with the keyboard}
{--------------------------------------------}
Procedure NewInt9;interrupt;
Begin
Keys[Port[$60] Mod 128] := (Port[$60] < 128) ;
{Checking if Port[$60] < 128 , If He Is , Keys[Port[$60] Mod 128]
Is True Else False}
Asm
PushF {Pushing Flags}
End;
OldInt9; {Calling the old interrupt}
Mem[$0040:$001A] := Mem[$0040:$001C];
{Puting The Tail And The Head , for clear the buffer}
End;
{-------------------------------------------}
{ Init The new interrupt }
{-------------------------------------------}
Procedure InitKeyboard;
Begin
GetIntVec($9,@OldInt9);
SetIntVec($9,@NewInt9);
End;
{--------------------------------------}
{ Restore The Old interrupt }
{--------------------------------------}
Procedure RestoreKeyBoard;
Begin
SetIntVec($9,@OldInt9);
End;
{------------------------------Mouse Routines------------------------------}
{--------------------------------------}
{ Get the mouse status }
{--------------------------------------}
Procedure GetMouse(Var Mouse:MouseType);Assembler;
Asm
Push Ds {Saving DS}
Mov Ax,0003h {Function 0003H INT 33H GET STATUS}
Int 33h
Lds Si,Mouse {[DS:SI] = MOUSE}
Shr CX,3 {FOR DIVIDE IT WITH 8}
Shr DX,3
Mov [Ds:Si],CX {[DS:SI] = X = CX}
Mov [Ds:Si+2],DX {[DS:SI+2] = Y = DX}
Mov [DS:Si+4],BX {[DS:SI+4] = BUTTON = BX}
Pop Ds {Restoring DS}
End;
{Thus function Reseting the mouse and return true if the mouse is installed}
Function ResetMouse:Boolean;Assembler;
Asm
Mov Ax,0000h
Int 33h
End;
{Show the mouse on the screen}
Procedure ShowMouse;Assembler;
Asm
Mov Ax,0001h
Int 33h
End;
{Hide the mouse from the screen}
Procedure HideMouse;Assembler;
Asm
Mov Ax,0002h
Int 33h
End;
End.